home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS11.ADF / AmigaBasicProgs / MailTalk.MSB (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-08-05  |  8KB  |  298 lines
  1. '*************************************
  2. 'A Basic Mail-List Manager
  3. 'By Marc Mandel
  4. 'Written for Amiga 1000
  5. 'June 6, 1986
  6. '*************************************
  7.  
  8. CLS:CLEAR 32767
  9. DIM p1$(200,5) :CLS: PRINT"Mailer Program, by M. Mandel"
  10. PRINT"(c) 1986 by Top Notch Management Group, Ltd."
  11. PRINT"All Rights Reserved."
  12. PRINT"Attach an amplifier for speech"
  13.  
  14. ON ERROR GOTO fixerr
  15. zach:
  16. a=0: 
  17. Zoho:
  18. MENU 5,0,1,"Mailer"
  19. MENU 5,1,1,"About Mailer "
  20. MENU 5,2,0,"-------------"
  21. MENU 5,3,1,"Open List    "
  22. MENU 5,4,a,"Add Names    "
  23. MENU 5,5,a,"Delete Names "
  24. MENU 5,6,a,"Examine Entry"
  25. MENU 5,7,a,"Update Entry "
  26. MENU 6,0,a,"Print"
  27. MENU 6,1,a,"Reports"
  28. MENU 6,2,a,"Labels "
  29. MENU 7,0,1,"Quit"
  30. MENU 7,1,1,"Quit"
  31. MENU ON
  32.  
  33. active:
  34. IF ra=0 THEN SAY TRANSLATE$ ("Please select a menu above with the right mouse button.")
  35. ra=ra+1
  36. m = MENU(0)  :rum = 1 : ty=1
  37. IF m < 4 THEN active
  38.  
  39. choice = MENU(1)
  40.  
  41. IF (m =5) AND (choice <= 3) OR (yuck=1)THEN ty=0
  42. IF ty=0  THEN yuckey
  43. IF m = 7 THEN yuckey
  44. BEEP:GOTO active
  45.  
  46.  
  47. yuckey:
  48. ra=0
  49. ON m-4 GOTO Main,Printer,Quit
  50. STOP
  51. about:
  52. WINDOW CLOSE 2
  53. IF yuck <> 1 THEN nr=0 : GOTO gotcha
  54. CLOSE 3 : OPEN"I",3,fs2$
  55. INPUT #3,nr : CLOSE 3
  56.  
  57. gotcha:
  58. SAY TRANSLATE$("Super Mailing List Program")
  59.  
  60. WINDOW 4,"About Mailing List",(60,35)-(350,95),0
  61. PRINT" Mailing List manager, version 1.0"
  62. PRINT"          by Marc C. Mandel"
  63. PRINT"   Written for Top Notch Mgt. Ltd"
  64. PRINT
  65. PRINT"  Currently there are ";nr;" records"
  66. PRINT
  67. PRINT"  Hit [Return] to continue w/ prog.";
  68. LINE INPUT a$
  69. WINDOW CLOSE 4
  70. GOTO active
  71.  
  72. update:
  73. PRINT"Update an entry in the file" : PRINT
  74. PRINT"Enter the COMPANY NAME to update"
  75. LINE INPUT xy$
  76. CLOSE 3 : OPEN"I",3,fs2$
  77. INPUT #3, xp
  78. CLOSE 3
  79. FOR n = 1 TO xp
  80. GET 1,n
  81. IF LEFT$(f1$,LEN(xy$))= xy$ THEN  GOTO winner :ELSE NEXT n : GOTO Notthere
  82. winner:
  83. CLS:PRINT"Company Name......"; f1$:PRINT"Address..........."; f2$
  84. PRINT"City,State Zip...."; f3$:PRINT"Phone............."; f4$
  85. PRINT"Contact..........."; f5$ : 
  86. PRINT :PRINT"Please enter the updated fields now, hit <ret> to preserve"
  87. PRINT"Company Name......";
  88. LINE INPUT x1$
  89. PRINT"Address...........";
  90. LINE INPUT x2$
  91. PRINT"City, State, Zip..";
  92. LINE INPUT x3$
  93. PRINT"Phone Number......";
  94. LINE INPUT x4$
  95. PRINT"Contact...........";
  96. LINE INPUT x5$
  97. Heckle:
  98. PRINT"Okay? (Y/N) ----->";
  99. LINE INPUT x$
  100. IF x$ = "N" OR x$="n" THEN CLOSE 3 : WINDOW CLOSE 2 : GOTO active
  101. IF x$ <>"Y" AND x$ <>"y" THEN Heckle
  102. IF x1$ <> "" THEN LSET f1$=x1$ :ELSE LSET f1$=f1$
  103. IF x2$ <> "" THEN LSET f2$=x2$ :ELSE LSET f2$=f2$
  104. IF x3$ <> "" THEN LSET f3$=x3$ :ELSE LSET f3$=f3$
  105. IF x4$ <> "" THEN LSET f4$=x4$ :ELSE LSET f4$=f4$
  106. IF x5$ <> "" THEN LSET f5$=x5$ :ELSE LSET f5$=f5$
  107. PUT 1,n
  108. CLOSE 3 : WINDOW CLOSE 2 : GOTO active
  109. Notthere:
  110. PRINT"The Record, ";xy$;" was not in the file. Find another (Y/N) ?";
  111. LINE INPUT xz$
  112. IF xz$="N" OR xz$="n" THEN WINDOW CLOSE 2 : GOTO active
  113. IF xz$ ="Y" OR xz$="y" THEN CLS : GOTO update
  114. GOTO Notthere
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121. Main:
  122. IF m=5 AND choice = 1 THEN xp=2 :ELSE xp=1
  123.  
  124. IF xp = 1 THEN GOSUB makewind
  125. ON choice GOTO about,,1100,1000,1200,1300,update
  126. STOP
  127.  
  128. Quit:
  129. CLOSE : CLS : PRINT"Exited Application at ";TIME$
  130. END
  131.  
  132. maker:
  133. 1000 CLS: PRINT"Add names to file"
  134. PRINT
  135. PRINT"Enter Company Name............";:LINE INPUT x1$
  136. PRINT"Enter Street Address..........";:LINE INPUT x2$
  137. PRINT"Enter City, State, Zip........";:LINE INPUT x3$
  138. PRINT"Enter Phone Number............";:LINE INPUT x4$
  139. PRINT"Enter Contact's Name..........";:LINE INPUT x5$
  140. PRINT 
  141.  
  142. geter:
  143. PRINT"All okay to enter to file? (Y/N) ---> "; 
  144. LINE INPUT a$ : IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP: GOTO geter
  145. IF a$ <>"Y" AND a$ <>"y" THEN maker
  146. LSET f1$=x1$ : LSET f2$=x2$ : LSET f3$=x3$ : LSET f4$ = x4$ : LSET f5$=x5$
  147. CLOSE 3 : OPEN"I",3,fs2$:INPUT#3,lf:lf=lf+1
  148. PUT 1,lf
  149. PRINT"File Stored at position #",lf
  150. CLOSE 3 : OPEN"O",3,fs2$ : PRINT#3,lf : CLOSE 3
  151.  
  152. maybe:
  153. PRINT"Add another? (Y/N) ---> ";
  154. LINE INPUT a$ :IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP:GOTO maybe
  155. IF a$ = "y" OR a$ = "Y" THEN GOTO maker :ELSE WINDOW CLOSE 2 :  GOTO active
  156.                                                                                                                                                               
  157.  
  158. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  159. 'Open a File
  160. '''''''''''''''''
  161.  
  162. 1100 PRINT"Enter the name for the file to be used.":CLOSE :rum=0:yuck=0
  163.  
  164. 1105 LINE INPUT f$
  165. 1110 PRINT"Stand by while I set up the file, named ";CHR$(34);f$;CHR$(34)
  166. 1115 OPEN"R",1,f$
  167. FIELD 1,25 AS f1$, 25 AS f2$, 25 AS f3$, 25 AS f4$, 25 AS f5$
  168. rum=-1 :yuck=1
  169. IF LOF(1) <> 0 THEN bigfile
  170. fs2$=f$+".NUM" : OPEN"O",3,fs2$
  171. PRINT#3,0: CLOSE 3
  172.  
  173. GOTO yahoo
  174. bigfile:
  175. fs2$=f$+".NUM"
  176. OPEN "I",3,fs2$ : INPUT #3, rn : CLOSE 3
  177. yahoo:
  178.  
  179.  
  180. 1125 PRINT"I'm Done. Now returning to main command area."
  181. 1130 FOR W = 1 TO 900: NEXT W:WINDOW CLOSE 2 :a=1: GOTO Zoho
  182.  
  183.  
  184. 1200 CLS : PRINT"Delete a name"
  185. OPEN"I",3,fs2$ : INPUT #3,rn : CLOSE 3
  186. FOR n = 1 TO rn : GET 1,n
  187. p1$(n,1) = f1$ : p1$(n,2) = f2$ : p1$(n,3)=f3$:p1$(n,4)=f4$ : p1$(n,5) = f5$
  188. NEXT n 
  189. PRINT"Enter Company Name to remove from data file"
  190. LINE INPUT x$
  191. pp=0
  192.  
  193. FOR n = 1 TO rn 
  194. IF LEFT$(p1$(n,1),LEN(x$)) = x$ THEN rw= 1 :GOTO abby
  195. PRINT"Moved entry";pp+1
  196. LSET f1$=p1$(n,1) : pp = pp+1
  197. LSET f2$=p1$(n,2) 
  198. LSET f3$=p1$(n,3) 
  199. LSET f4$=p1$(n,4) 
  200. LSET f5$=p1$(n,5) 
  201. rq = pp
  202. PUT 1,rq 
  203. abby:
  204. NEXT n  :CLOSE 3 
  205. OPEN"O",3,fs2$ :PRINT#3,pp: CLOSE 3
  206. CLOSE 3
  207. ng:
  208. IF rw=1 THEN PRINT: PRINT"Record Deleted." :ELSE PRINT"Record not found"
  209. rw=0
  210. LINE INPUT"<Enter> to continue.";a$  
  211. WINDOW CLOSE 2 :GOTO active
  212.  
  213.  
  214.  
  215. Printer:
  216. GOSUB makewind
  217. IF choice = 1 THEN CLS : PRINT"Output List to Video Screen" : PRINT
  218. IF choice = 2 THEN labels
  219. OPEN"I",3,fs2$ : INPUT#3,xp : CLOSE 3
  220. FOR n = 1 TO xp: GET 1,n
  221. PRINT f1$: NEXT n  :PRINT: PRINT"....Done...."
  222. FOR n = 1 TO 1000 : NEXT n :LINE INPUT"<Enter> to continue.";a$ 
  223.  WINDOW CLOSE 2 : GOTO active
  224.  
  225. 1300 CLS : PRINT"Find a Name Function" : PRINT
  226. PRINT"Enter enough characters of company name for identification"
  227. LINE INPUT a$ : CLOSE 3
  228. OPEN"I",3,fs2$ : INPUT #3,xn : CLOSE 3 
  229. FOR n = 1 TO xn
  230. GET 1,n
  231. IF LEFT$(f1$,LEN(a$)) = a$ THEN 1350 :ELSE NEXT n : PRINT"Name not on file"
  232. PRINT"Shall I find another name? (Y/N) --> ";
  233. shit:
  234. a$ = INKEY$:IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" AND a$<>"" THEN BEEP:GOTO shit
  235. IF a$ = "Y" OR a$ = "y" THEN 1300
  236. WINDOW CLOSE 2: GOTO active
  237.  
  238. 1350 PRINT : PRINT"Name On File As Follows"
  239. PRINT f1$ : PRINT f2$ : PRINT f3$: PRINT f4$ : PRINT f5$
  240. PRINT: PRINT"Find Another? (Y/N) ---> "
  241. crummy:
  242. a$ = INKEY$:IF a$ = "" THEN crummy :ELSE IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP:GOTO crummy
  243. IF a$ = "Y" OR a$="y" THEN 1300 :ELSE WINDOW CLOSE 2 : GOTO active
  244.  
  245. labels:
  246. PRINT"Print Mailing Labels"
  247. PRINT
  248. PRINT"<1> Do a label-line test      <2> Print Production Labels"
  249. PRINT"<3> Abort"
  250. PRINT
  251. PRINT"Enter your choice (1,2,3) --> ";
  252. LINE INPUT a$
  253. IF a$="3" THEN WINDOW CLOSE 2: GOTO active
  254. IF a$="2" THEN GOTO RunLabels
  255. FOR n = 1 TO 4 : LPRINT STRING$(25,"X") : NEXT n :LPRINT:LPRINT
  256.  
  257. CLS : GOTO labels
  258. RunLabels:
  259. CLOSE 3 : OPEN"I",3,fs2$
  260. INPUT #3, rn : CLOSE 3
  261. FOR n = 1 TO rn
  262. GET 1,n
  263. LPRINT TAB(5);f1$ : LPRINT TAB(5);f2$ : LPRINT TAB(5);f3$
  264.  LPRINT TAB(5);"Attn: ";f5$ :LPRINT:LPRINT
  265. IF INKEY$ <> "" THEN aborter  
  266. gumby:
  267. NEXT n : WINDOW CLOSE 2 : GOTO active
  268.  
  269. aborter:
  270. PRINT : PRINT"Are you sure you want to abort? (Y/N) --> ";
  271. LINE INPUT a$ : IF a$ ="Y" OR a$="y" THEN WINDOW CLOSE 2 : GOTO active
  272. IF a$="N" OR a$="n" THEN gumby
  273. GOTO aborter
  274.  
  275.  
  276. October:
  277. xw=INT(LOF(1)/125)
  278. PRINT"Currently, there are ";xw;"Records according to Fn 1"
  279. CLOSE 3 : OPEN"I",3,fs2$: INPUT #3,xr : close3
  280. PRINT"Currently there are";xr;"records according to FN 3"
  281. rum=1 : RETURN
  282.  
  283. makewind:
  284. WINDOW 2,"Function Window",(8,40)-(615,160),4
  285. COLOR 1,2  :CLS
  286.  
  287. RETURN
  288.  
  289.  
  290.  
  291.  
  292. fixerr:
  293. CLS : PRINT"Error Occurred! Warning!!!"
  294. PRINT"Error at";ERL;"of the type";ERR
  295.  
  296. RESUME active
  297.  
  298.